C--------------------------------------------------------------------------- 

C Program name: StructureDraw test program.

C Author: Gareth Williams

C Description:

C Modification history : (Version), (Date), (Name), (Description).

C 1.0, 1st July 1991, G. Williams, First Version.

C 2.0, June 1992, G. Williams, Converted to SunPHIGS 2.0.

C----------------------------------------------------------------------------
          
       PROGRAM stcttest
       INTEGER err, minid, maxid, pid
       LOGICAL ptkf_readphinterscript
       INTEGER ptkf_stringtoint
       LOGICAL docolour

       include './sunphigs77.h'

       implicit undefined (P, p, E, e)

C colour or monochrome
       docolour = .TRUE.

       print *,('Demonstrating the structure draw module of the 
& PHIGS Toolkit...')
       print *,('Opening SunPHIGS...')

       call popph(6, 0)

C     create the workstation type (either tool or canvas) 
              
C     open the workstation 

       if (ptkf_readphinterscript('../../scripts/openws.scr', 0, 0) .eq.
& .FALSE.) then     
         goto 30
       endif

       call psdus(1, PWAITD, PNIVE)
       minid = 1
       maxid = 30
       call ptkf_inithashtables()
       call ptkf_createhashtable('structureid', minid, maxid)
       call ptkf_createhashtable('label', 0, maxid)
       call ptkf_createhashtable('name', 0, maxid)
       call ptkf_createhashtable('colourindex', 1, 8)

       if (docolour .eq. .TRUE.) then
         call ptkf_setcolourrep(1, 'black')
         call ptkf_setcolourrep(1, 'white')
         call ptkf_setcolourrep(1, 'grey')
         call ptkf_setcolourrep(1, 'green')
         call ptkf_setbackgroundcolourind(1, 
& ptkf_stringtoint('colourindex', 'grey'))
       endif
       
       if (ptkf_readphinterscript('../../scripts/postcard.scr', 
& 0, 0)) then
         call popst(ptkf_stringtoint('structureid', 'content'))
         call set_attrs(docolour)
         pid = ptkf_stringtoint('structureid', 'postcard')
         call ptkf_structcontent(1, pid, 1, 0, 0, PFONTTRIPLEX, err)
         call pclst()
       
         if (err .eq. 0) then
           call ppost(1, ptkf_stringtoint('structureid', 'content'), 
& 0.0)
         endif

         call puwk(1, PPERFO)
         call options(docolour)
       endif

 30    call pclwk(1)
       call pclph()

       STOP
       END

C--------------------------------------------------------------------------

       SUBROUTINE options(docolour)
       LOGICAL docolour
       CHARACTER*20 commandstr, postcdstr, rangestr, pointstr, quitstr
       INTEGER lencom, err, elem1, elem2, eptr, postcardid
       LOGICAL structquit
       REAL echoarea(4)
       INTEGER ptkf_readint
       INTEGER ptkf_stringtoint

       include './sunphigs77.h'
       
       postcdstr = 'postcard'
       rangestr = 'range'
       pointstr = 'pointer'
       quitstr = 'quit'
       structquit = .FALSE.
       eptr = 0
       postcardid = ptkf_stringtoint('structureid', 'postcard')
       call ptkf_limit(0.0, 0.25, 0.0, 0.01, echoarea)
 10    call ptkf_readstring(1, 'range', 
& 'Input command (default = range) >', echoarea, 20, commandstr, 
& lencom)
       if (commandstr(1:lencom) .eq. rangestr(1:lencom)) then
          elem1 = ptkf_readint(1, 1, 'Input element number (1) >', 
& echoarea)
          elem2 = ptkf_readint(1, 0, 'Input element number (0) >', 
& echoarea)
          call pemst(ptkf_stringtoint('structureid', 'content'))
          call popst(ptkf_stringtoint('structureid', 'content'))
          call set_attrs(docolour)
          call ptkf_structcontent(1, postcardid, elem1, elem2, eptr, 
& PFONTTRIPLEX, err)
          call pclst()
          call prst(1, PALWAY)
       else if (commandstr(1:lencom) .eq. pointstr(1:lencom)) then
          eptr = ptkf_readint(1, 0, 'Input element pointer (0) >', 
& echoarea)
          call popst(ptkf_stringtoint('structureid', 'content'))
          call ptkf_setstructcontentelemptr(ptkf_stringtoint(
& 'structureid', 'content'), eptr)
          call pclst()
          call prst(1, PALWAY)
       else if (commandstr(1:lencom) .eq. quitstr(1:lencom)) then
          structquit = .TRUE.
       else
          print *,('Command unknown')    
       endif

       if (structquit .eq. .TRUE.) then
         goto 20
       else 
         goto 10
       endif

 20    RETURN
       END

C--------------------------------------------------------------------------

       SUBROUTINE set_attrs(docolour)
       LOGICAL docolour
       INTEGER green, grey, white, black
       INTEGER ptkf_stringtoint

       include './sunphigs77.h'

       if (docolour .eq. .TRUE.) then
         green = ptkf_stringtoint('colourindex', 'green')
         grey = ptkf_stringtoint('colourindex', 'grey')
         white = ptkf_stringtoint('colourindex', 'white')
         black = ptkf_stringtoint('colourindex', 'black')
         call pstxci(black)
         call psedfg(PON)
         call psis(PSOLID)
         call psedci(white)
         call psici(green)
       endif

       RETURN
       END

C--------------------------------------------------------------------------
          
C     end of stcttest.f
